home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / misc / vgadoc3.arj / IDVGA.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-18  |  47KB  |  1,957 lines
  1.  
  2.     (* Analyse the current mode *)
  3.  
  4. procedure AnalyseMode; {(mode:word;var pixs,lins,bytes,vseg:word;var mmode:mmods);}
  5.  
  6.  
  7. procedure dumprg(base,start,ende:word;var rg:regblk);
  8. var six,ix:word;
  9.   same:boolean;
  10. begin
  11.   rg.base:=base;
  12.   six:=inp(base);
  13.   outp(base,0);
  14.   ix:=inp(base) xor 255;
  15.   outp(base,255);
  16.   ix:=ix and inp(base);
  17.  
  18.   if ende=0 then
  19.     if ix>127 then ende:=255
  20.     else if ix>63 then ende:=127
  21.     else if ix>31 then ende:=63
  22.     else if ix>15 then ende:=31
  23.     else if ix>7 then ende:=15
  24.     else ende:=7;
  25.   for ix:=start to ende do
  26.     rg.x[ix]:=rdinx(base,ix);
  27.   rg.nbr:=ende;
  28.   outp(base,six);
  29.   same:=true;
  30.   while (rg.nbr>7) and same do    {Check for doubles}
  31.   begin
  32.     six:=succ(rg.nbr) div 2;
  33.     for ix:=0 to six-1 do
  34.       if rg.x[ix]<>rg.x[ix+six] then same:=false;
  35.     if same then rg.nbr:=rg.nbr div 2;
  36.   end;
  37.  
  38. end;
  39.  
  40. procedure DumpTridOldRegs;
  41. begin
  42.   wrinx(SEQ,$B,0);
  43.   rgs.tridold0d:=rdinx(SEQ,$D);
  44.   rgs.tridold0e:=rdinx(SEQ,$E);
  45.   oldreg:=true;
  46. end;
  47.  
  48. procedure DumpXGAregs;
  49. var x:word;
  50. begin
  51.   dumprg(IOadr+10,0,0,rgs.xxregs);
  52.   for x:=0 to 15 do
  53.     rgs.xgaregs[x]:=inp(IOadr+x);
  54. end;
  55. const
  56.   tridclk:array[0..15] of real=(25.175,28.322,44.9,36,57.272,65,50.35,40
  57.                   ,88,98,118.89,108,72,77,80,75);
  58.   triddiv:array[0..3] of real=(1,2,4,1.5);
  59.   HMCclk:array[0..7] of real=(25.175,28.322,0,37.2,40,44.9,0,65);
  60.   v7clk:array[0..7] of real=(25.175,28.322,30,32.514,34,36,38,40);
  61.   aticlk1:array[0..7] of real=(50.175,56.644,0,44.9,44.9,50.157,0,36);
  62.   aticlk2:array[0..15] of real=(42.954,48.771,16.657,36,50.35,56.64
  63.        ,28.322,44.9,30.24,32,37.5,39,40,56.644,75,65);
  64.   atidiv:array[0..3] of integer=(1,2,3,4);
  65.   WDclk:array[0..7] of real=(40,50,0,44.9,25.175,28.322,65,36.242);
  66. var x,m,wid,wordadr,pixwid,clksel:word;
  67.     force256,graph:boolean;
  68.     vtot:word;
  69. begin
  70.  
  71.   case chip of  (* Enable ext *)
  72.     __S3:begin
  73.        wrinx(crtc,$38,$48);
  74.        wrinx(crtc,$39,$A5);
  75.      end;
  76.   end;
  77.   fillchar(rgs,sizeof(rgs),0);
  78.   oldreg:=false;
  79.   vclk:=0;
  80.   for x:=$3C2 to $3DF do rgs.stdregs[x]:=inp(x);
  81.   rgs.stdregs[$3DA]:=inp(CRTC+6);
  82.   rgs.stdregs[$3C0]:=inp($3C0);
  83.   for x:=0 to 31 do rgs.attregs[x]:=rdinx($3C0,x);
  84.   x:=rdinx($3C0,$30);
  85.   rgs.mode:=curmode;
  86.   dumprg(CRTC,0,0,rgs.crtcregs);
  87.   dumprg(SEQ,0,0,rgs.seqregs);
  88.   dumprg(GRC,0,0,rgs.grcregs);
  89.   case chip of
  90.     __ati1,__ati2,__atiGUP:
  91.       dumprg(IOadr,$A0,$BF,rgs.xxregs);
  92.   __chips451,__chips452,__chips453:
  93.       dumprg(IOadr,0,0,rgs.xxregs);
  94.  __compaq:begin
  95.         for x:=1 to 15 do
  96.           for m:=0 to 15 do
  97.         rgs.xxregs.x[(x-1)*16+m]:=inp(x*$1000+$3C0+m);
  98.         rgs.xxregs.base:=$3C;
  99.         rgs.xxregs.nbr:=240;
  100.  
  101.       end;
  102.  __ET4W32:dumprg($217A,0,0,rgs.xxregs);
  103.     __hmc:dumprg(SEQ,$0,$FF,rgs.xxregs);
  104.   __oak87,
  105.     __oak:dumprg($3DE,0,0,rgs.xxregs);
  106.     __trid89,__tridBR,__tridCS:
  107.       DumpTridOldRegs;
  108.  __iitagx:if (inp(IOadr) and 4)=0 then DumpTridOldRegs
  109.       else DumpXGAregs;
  110.     __xga:DumpXGAregs;
  111.   else rgs.xxregs.base:=0;
  112.   end;
  113.   case chip of  (* Disable ext *)
  114.     __S3:begin
  115.        wrinx(crtc,$38,0);
  116.         wrinx(crtc,$39,$5A);
  117.      end;
  118.   end;
  119.  
  120.   m:=rgs.grcregs.x[6];
  121.   case (m shr 2) and 3 of
  122.   0,1:calcvseg:=$a000;
  123.     2:calcvseg:=$b000;
  124.     3:calcvseg:=$b800;
  125.   end;
  126.   clksel:=(rgs.stdregs[$3CC] shr 2) and 3;
  127.  
  128.   begin
  129.     ilace:=false;
  130.     extpixfact:=1;
  131.     extlinfact:=1;
  132.  
  133.     calclines:=rgs.crtcregs.x[$12]+1;
  134.     x:=rgs.crtcregs.x[7];
  135.     if (x and 2)<>0 then inc(calclines,256);
  136.     if (x and 64)<>0 then inc(calclines,512);
  137.     pixwid:=8;
  138.     calcpixels:=rgs.crtcregs.x[1]+1;
  139.     force256:=false;
  140.     vtot:=rgs.crtcregs.x[0]+5;
  141.  
  142.     graph:=(rgs.attregs[$10] and 1)>0;
  143.     if graph then
  144.     begin
  145.       extlinfact:=(rgs.crtcregs.x[9] and $1F)+1;
  146.       if (rgs.crtcregs.x[9] and $80)>0 then extlinfact:=extlinfact*2;
  147.     end
  148.     else begin
  149.       if (rgs.attregs[$10] and 4)>0 then charwid:=9 else charwid:=8;
  150.       charhigh:=(rgs.crtcregs.x[9] and $1f)+1;
  151.     end;
  152.  
  153.     wid:=rgs.crtcregs.x[$13];
  154.     wordadr:=2;
  155.     if (rgs.crtcregs.x[$14] and 64)<>0 then wordadr:=8
  156.     else if (rgs.crtcregs.x[$17] and 64)=0 then wordadr:=4;
  157.     case chip of
  158.     __aheada,__aheadb:
  159.          begin
  160.            if (rgs.grcregs.x[$1c] and 12)=12 then ilace:=true;
  161.            if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=16;
  162.  
  163.          end;
  164.       __ati1:begin
  165.            if (rgs.xxregs.x[$B2] and 1)<>0 then ilace:=true;
  166.            if (rgs.xxregs.x[$B2] and 64)>0 then inc(clksel,4);
  167.            if (rgs.xxregs.x[$B0] and $20)>0 then
  168.            begin
  169.          force256:=true;
  170.          wordadr:=8;
  171.            end;
  172.            vclk:=aticlk1[clksel]/atidiv[rgs.xxregs.x[$B8] shr 6];
  173.          end;
  174.     __atiGUP,
  175.       __ati2:begin
  176.            if (rgs.xxregs.x[$BE] and 2)<>0 then ilace:=true;
  177.            if (rgs.xxregs.x[$B0] and $20)>0 then
  178.            begin
  179.          force256:=true;
  180.          wordadr:=16;
  181.            end;
  182.            if version=ATI_18800_1 then
  183.            begin
  184.          if (rgs.xxregs.x[$BE] and 16)>0 then inc(clksel,4);
  185.          vclk:=aticlk1[clksel];
  186.            end
  187.            else begin
  188.          if (rgs.xxregs.x[$B9] and 2)>0 then inc(clksel,4);
  189.          if (rgs.xxregs.x[$BE] and 16)>0 then inc(clksel,8);
  190.          vclk:=aticlk2[clksel];
  191.            end;
  192.            vclk:=vclk/atidiv[rgs.xxregs.x[$B8] shr 6];
  193.          end;
  194.     __al2101:begin
  195.            if ((rgs.grcregs.x[$C] and $10)<>0) then wordadr:=wordadr shl 1;
  196.            if (rgs.crtcregs.x[$19] and 1)<>0 then
  197.            begin
  198.          ilace:=true;
  199.          wordadr:=wordadr shr 1;
  200.            end;
  201.          end;
  202.   __chips451,__chips453,
  203.   __chips452:begin
  204.            if (rgs.xxregs.x[$D] and 1)<>0 then inc(wid,256);
  205.            if (rgs.seqregs.x[4] and 8)<>0 then
  206.            begin
  207.          wordadr:=8;
  208.          calcpixels:=calcpixels shr 1;
  209.            end;
  210.          end;
  211.      __cir54:begin
  212.            if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=8;
  213.            if (rgs.crtcregs.x[$1B] and 16)<>0 then inc(wid,256);
  214.            if (rgs.crtcregs.x[$1A] and 1)<>0 then ilace:=true;
  215.            vclk:=(14.31818*rgs.seqregs.x[$B+clksel])/(rgs.seqregs.x[$1B+clksel] shr 1);
  216.            if (rgs.seqregs.x[$1B+clksel] and 1)>0 then vclk:=vclk/2;
  217.            case (rgs.seqregs.x[7] and 6) of
  218.          2:vclk:=vclk/2;
  219.          4:vclk:=vclk/3;
  220.            end;
  221.          end;
  222.      __cir64:begin
  223.            if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=8;
  224.            if (rgs.grcregs.x[$82] and 7)=2 then pixwid:=4;
  225.          end;
  226.     __compaq:begin
  227.            if (rgs.grcregs.x[$F] and $F0)=0 then wordadr:=8;
  228.            if (rgs.grcregs.x[$42] and 1)>0 then inc(wid,256);
  229.            if (rgs.crtcregs.x[$14] and 64)>0 then pixwid:=4;
  230.          end;
  231.     __ET3000:begin
  232.            if (rgs.crtcregs.x[$25] and $80)>0 then ilace:=true;
  233.            if (rgs.grcregs.x[5] and $40)>0 then wordadr:=16;
  234.            if (rgs.seqregs.x[7] and $40)>0 then
  235.            begin
  236.          pixwid:=pixwid*2;
  237.          wordadr:=wordadr*2;
  238.            end;
  239.          end;
  240.     __ET4w32,
  241.     __ET4000:if (rgs.crtcregs.x[$3f] and 128)<>0 then inc(wid,256);
  242.      __genoa:if (rgs.crtcregs.x[$2F] and 1)<>0 then ilace:=true;
  243.        __hmc:begin
  244.                IF (rgs.xxregs.x[$E7] and 1)>0 then ilace:=true;
  245.                if (rgs.xxregs.x[$E7] and 2)>0 then force256:=true;
  246.                if (rgs.xxregs.x[$E7] and 64)>0 then inc(clksel,4);
  247.                vclk:=HMCclk[clksel];
  248.              end;
  249.     __iitagx:if (inp(IOadr) and 4)=0 then
  250.          begin
  251.            if (rgs.tridold0d and 16)<>0 then wordadr:=wordadr*2;
  252.            if (rgs.seqregs.x[4] and 8)>0 then pixwid:=4;
  253.          end
  254.          else begin
  255.            calcpixels:=rgs.xxregs.x[$13]*256+rgs.xxregs.x[$12]+1;
  256.            pixwid:=8;
  257.            calclines :=rgs.xxregs.x[$23]*256+rgs.xxregs.x[$22]+1;
  258.            wid :=rgs.xxregs.x[$44]*256+rgs.xxregs.x[$43];
  259.            wordadr:=8;
  260.          end;
  261.       __mxic:if (rgs.seqregs.x[$F0] and 3)=3 then ilace:=true;
  262.        __NCR:begin
  263.            if (rgs.seqregs.x[$20] and 2)<>0 then
  264.            begin
  265.          force256:=true;
  266.          wordadr:=8;
  267.            end;
  268.            if (rgs.seqregs.x[$1F] and $10)<>0 then
  269.          case rgs.seqregs.x[$1F] and 15 of
  270.            0:pixwid:=4;
  271.           11:pixwid:=16;
  272.          else pixwid:=(rgs.seqregs.x[$1F] and 15)+6;
  273.          end;
  274.            if (rgs.crtcregs.x[$30] and 2)<>0 then inc(calcpixels,256);
  275.            if (rgs.crtcregs.x[$30] and $10)<>0 then
  276.            begin
  277.          ilace:=true;
  278.          extlinfact:=1;
  279.            end;
  280.          end;
  281.        __oak:begin
  282.            if (rgs.xxregs.x[$14] and 128)<>0 then ilace:=true;
  283.            if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=16;
  284.                       {Cheat for 256 color mode}
  285.          end;
  286.      __oak87:begin
  287.            if (rgs.xxregs.x[$14] and 128)<>0 then ilace:=true;
  288.            if (rgs.seqregs.x[4] and 8)<>0 then
  289.          if (rgs.xxregs.x[$21] and 4)>0 then wordadr:=16
  290.                         else pixwid:=4;
  291.          end;
  292.      __p2000:begin
  293.            if (rgs.grcregs.x[$13] and 64)<>0 then
  294.            begin
  295.          wordadr:=wordadr shr 1;
  296.          ilace:=true;
  297.            end;
  298.            if (rgs.grcregs.x[$21] and 32)<>0 then inc(wid,256);
  299.          end;
  300.   __paradise:begin
  301.  
  302.            if (version>=WD_90c00) and ((rgs.crtcregs.x[$2D] and $20)<>0) then ilace:=true;
  303.            if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=8;
  304.                       {Cheat for 256 color mode}
  305.            if (rgs.grcregs.x[$C] and 2)>0 then inc(clksel,4);
  306.            vclk:=WDclk[clksel];
  307.            if (version>=WD_90c33) and ((rgs.crtcregs.x[$3E] and $20)>0) then inc(vtot,256);
  308.          end;
  309.    __realtek:begin
  310.            if (rgs.seqregs.x[4] and 8)<>0 then pixwid:=4;
  311.            if (rgs.grcregs.x[$C] and $10)<>0 then
  312.            begin
  313.          pixwid:=pixwid*2;
  314.          wid:=wid*2;
  315.            end;
  316.            if (rgs.crtcregs.x[$19] and 1)<>0 then
  317.            begin
  318.          ilace:=true;
  319.          wid:=wid div 2;
  320.            end;
  321.          end;
  322.     __s3:begin
  323.            if (rgs.crtcregs.x[$42] and $20)<>0 then ilace:=true;
  324.            if (rgs.crtcregs.x[$43] and 4)<>0   then inc(wid,256);
  325.            if (rgs.crtcregs.x[$43] and 128)<>0 then pixwid:=pixwid*2;
  326.            if (rgs.seqregs.x[4] and 8)<>0 then wordadr:=8 else wordadr:=2;
  327.            if (rgs.attregs[$10] and 1)=0 then wid:=wid*2;
  328.          end;
  329.     __tridCS,
  330.     __trid89:begin
  331.            if (rgs.tridold0d and 16)<>0 then wordadr:=wordadr*2
  332.            else if (rgs.seqregs.x[4] and 8)>0 then pixwid:=pixwid div 2;
  333.            if (rgs.crtcregs.x[$1e] and 4)<>0 then
  334.            begin
  335.          ilace:=true;
  336.          wordadr:=wordadr div 2;
  337.            end;
  338.            if (rgs.tridold0E and $10)>0 then inc(clksel,8)
  339.            else if (rgs.seqregs.x[$D] and 1)>0 then inc(clksel,4);
  340.            vclk:=tridclk[clksel]/triddiv[(rgs.seqregs.x[$D] shr 1) and 3];
  341.          end;
  342.        __UMC:begin
  343.            if (rgs.crtcregs.x[$2F] and 1)>0 then
  344.            begin
  345.          ilace:=true;
  346.          wordadr:=wordadr div 2;
  347.            end;
  348.            if (rgs.crtcregs.x[$33] and $10)>0 then wordadr:=16;
  349.          end;
  350.     __video7:begin
  351.            if (rgs.seqregs.x[$E0] and $10)<>0 then ilace:=true;
  352.            vclk:=v7clk[(rdinx(SEQ,$A4) shr 2) and 7];
  353.          end;
  354.        __xbe,
  355.        __xga:begin
  356.            calcpixels:=rgs.xxregs.x[$13]*256+rgs.xxregs.x[$12]+1;
  357.            pixwid:=8;
  358.            calclines:=rgs.xxregs.x[$23]*256+rgs.xxregs.x[$22]+1;
  359.            wid :=rgs.xxregs.x[$44]*256+rgs.xxregs.x[$43];
  360.            wordadr:=8;
  361.          end;
  362.     end;
  363.     if ilace then calclines:=calclines*2;
  364.     if (rgs.attregs[$10] and 1)=0 then  {Text}
  365.     begin
  366.       calclines:=calclines div ((rgs.crtcregs.x[9] and $1F)+1);
  367.       if (rgs.attregs[$10] and 2)=0 then calcmmode:=_TEXT
  368.                     else calcmmode:=_TEXT4;
  369.       pixwid:=charwid;
  370.     end
  371.     else begin
  372.       if (rgs.crtcregs.x[$17] and 1)=0 then {CGA}
  373.       begin
  374.     if (rgs.crtcregs.x[$17] and $40)>0 then calcmmode:=_cga1
  375.                        else calcmmode:=_cga2;
  376.     extlinfact:=extlinfact shr 1;
  377.       end
  378.       else if ((rgs.attregs[$10] and 64)=0) and ((rgs.grcregs.x[5] and 64)=0)
  379.        and not force256 then  {16 color}
  380.       begin
  381.     if {((rgs.crtcregs.x[$17] and $20)=0)
  382.      or} ((rgs.attregs[$10] and 2)>0) then calcmmode:=_pl1
  383.     else if (rgs.attregs[$12]=5) then
  384.     begin
  385.       calcmmode:=_pl2;
  386.       pixwid:=pixwid*2;
  387.     end
  388.     else if (rgs.seqregs.x[4] and 8)>0 then calcmmode:=_pk4
  389.                        else calcmmode:=_pl4;
  390.       end
  391.       else begin
  392.     calcmmode:=_p8;
  393.     if dactype>_dac8 then
  394.     begin
  395.       x:=getdaccomm;
  396.  
  397.       case dactype of
  398.         _dac15:if x>127 then calcmmode:=_p15;
  399.         _dac16:case (x and $c0) of
  400.              $80:calcmmode:=_p15;
  401.              $c0:calcmmode:=_p16;
  402.            end;
  403.       _dacss24:begin
  404.          (*    while x<>$8e do x:=inp($3C6); *)
  405.              x:=inp($3C6);
  406.              rgs.stdregs[$3c1]:=x;
  407.              case x of
  408.               $a6:calcmmode:=_p16;
  409.               $A0:calcmmode:=_p15;
  410.               $9E:calcmmode:=_p24;
  411.              end;
  412.            end;
  413.        _dacatt:case (x and $E0) of
  414.          $80,$A0:calcmmode:=_p15;
  415.              $C0:calcmmode:=_p16;
  416.              $E0:calcmmode:=_p24;
  417.            end;
  418.      _dacadac1:case (x and $C7) of
  419.              $C1:calcmmode:=_p16;
  420.              $C5:calcmmode:=_p24;
  421.              $80:calcmmode:=_p15;
  422.            end;
  423.       _dacSC24:case (x and $E0) of
  424.          $80,$A0:calcmmode:=_p15;
  425.          $C0,$E0:calcmmode:=_p16;
  426.              $60:calcmmode:=_p24;
  427.            end;
  428.       _dacCL24:case x of
  429.              $F0:calcmmode:=_p15;
  430.              $E1:calcmmode:=_p16;
  431.              $E5:calcmmode:=_p24;
  432.            end;
  433.        _dacmus:case (x and $e0) of
  434.              $a0:calcmmode:=_p15;
  435.              $c0:calcmmode:=_p16;
  436.              $e0:calcmmode:=_p24;
  437.            end;
  438.        _dacalg:if (rgs.crtcregs.x[$19] and 16)<>0 then calcmmode:=_p16;
  439.          _dacBt484:case inp($3C8+DAC_RS3) and $78 of
  440.                      $10:calcmmode:=_p32;
  441.                      $30:calcmmode:=_p15;
  442.                      $38:calcmmode:=_p16;
  443.                    end;
  444.       end;
  445.       if (dactype<>_dacCL24) and (dactype<>_dacBt484) then
  446.         case calcmmode of               {Adjust for HiColor}
  447.       _p15,_p16:calcpixels:=calcpixels div 2;
  448.            _p24:calcpixels:=calcpixels div 3;
  449.         end;
  450.     end;
  451.       end;
  452.       calcpixels:=calcpixels*pixwid;
  453.     end;
  454.     calcbytes:=wid*wordadr;
  455.   end;
  456.   if (rgs.seqregs.x[1] and 8)>0 then vclk:=vclk/2;
  457.   if vclk>0 then
  458.   begin
  459.     hclk:=(vclk*1000)/(vtot*pixwid);
  460.     x:=rgs.crtcregs.x[6]+2;
  461.     if (rgs.crtcregs.x[7] and 1)>0 then inc(x,256);
  462.     if (rgs.crtcregs.x[7] and $20)>0 then inc(x,512);
  463.     fclk:=hclk*1000/x;
  464.   end;
  465.   if extlinfact>0 then calclines:=calclines div extlinfact;
  466.  
  467.   rgs.bytes :=calcbytes;
  468.   rgs.pixels:=calcpixels;
  469.   rgs.lins  :=calclines;
  470.   rgs.mmode :=calcmmode;
  471.   rgs.chip  :=chip;
  472. end;
  473.  
  474.  
  475.  
  476. procedure wrregs(var rg:regblk);
  477. var x:word;
  478. begin
  479.   write(hex4(rg.base)+':');
  480.   for x:=0 to rg.nbr do
  481.   begin
  482.     if (x mod 25=0) and (x>0) then
  483.       write('('+hex2(x)+'):');
  484.  
  485.     write(' '+hex2(rg.x[x]));
  486.   end;
  487.   writeln;
  488. end;
  489.  
  490. function dumpVGAregs:word;
  491. var x:word;
  492. begin
  493.   textmode($103);  {Set 43/50 line text mode}
  494.   writeln('Mode: '+hex2(rgs.mode)+'h Pixels: '+istr(rgs.pixels)+' lines: '+istr(rgs.lins)
  495.        +' bytes: '+istr(rgs.bytes)+' colors: '+istr(modecols[rgs.mmode]));
  496.   writeln;
  497.   if oldreg then writeln('SEQ (OLD): 0Dh: ',hex2(rgs.tridold0d)
  498.                   ,' 0Eh: ',hex2(rgs.tridold0e));
  499.  
  500.   for x:=$3C0 to $3CF do write(' '+hex2(rgs.stdregs[x]));
  501.   writeln;
  502.   for x:=$3D0 to $3DF do write(' '+hex2(rgs.stdregs[x]));
  503.   writeln;
  504.   write('03C0:');
  505.   for x:=0 to 31 do
  506.   begin
  507.     if x=25 then write('(19):');
  508.     write(' '+hex2(rgs.attregs[x]));
  509.   end;
  510.   writeln;
  511.   wrregs(rgs.seqregs);
  512.   wrregs(rgs.grcregs);
  513.   wrregs(rgs.crtcregs);
  514.   if rgs.xxregs.base<>0 then
  515.   begin
  516.     if (rgs.xxregs.base and $ff8f)=$210A then
  517.     begin
  518.       write(hex4(rgs.xxregs.base and $fff0)+':');
  519.       for x:=0 to 15 do write(' '+hex2(rgs.xgaregs[x]));
  520.       writeln;
  521.     end;
  522.     wrregs(rgs.xxregs);
  523.   end;
  524.   writeln;
  525.   dumpVGAregs:=getkey;
  526. end;
  527.  
  528. function FormatRgs(var b:byte):word;   {Format registers for dump}
  529. type
  530.   barr=array[1..2000] of byte;
  531. var
  532.   blk:^barr;
  533.   bts,x:word;
  534.  
  535. procedure appb(b:byte);
  536. begin
  537.   inc(bts);
  538.   blk^[bts]:=b;
  539. end;
  540.  
  541. procedure appw(w:word);
  542. begin
  543.   appb(lo(w));
  544.   appb(hi(w));
  545. end;
  546.  
  547. procedure apprgs(var r:regblk);
  548. var x:word;
  549. begin
  550.   appw(1);
  551.   appw(r.base);
  552.   appb(0);
  553.   appb(r.nbr);
  554.   for x:=0 to r.nbr do appb(r.x[x]);
  555. end;
  556.  
  557. begin
  558.   blk:=@b;
  559.   bts:=0;
  560.   appw(1);
  561.   appw($3C0);
  562.   appb(0);
  563.   appb(31);
  564.   for x:=0 to 31 do appb(rgs.attregs[x]);
  565.   apprgs(rgs.seqregs);
  566.   apprgs(rgs.grcregs);
  567.   apprgs(rgs.crtcregs);
  568.   if rgs.xxregs.base<>0 then apprgs(rgs.xxregs);
  569.   if oldreg then
  570.   begin
  571.     appw($FF);
  572.     appw(0);
  573.     appb(rgs.tridold0d);
  574.     appw($FF);
  575.     appw(1);
  576.     appb(rgs.tridold0e);
  577.   end;
  578.   if (rgs.xxregs.base and $FF8F)=$210A then
  579.   begin
  580.     appw(16);
  581.     appw(rgs.xxregs.base-$A);
  582.     for x:=0 to 15 do appb(rgs.xgaregs[x]);
  583.   end;
  584.   appw($3C2);
  585.   appb(rgs.stdregs[$3C2]);
  586.   appw(8);
  587.   appw($3C6);
  588.   for x:=$3C6 to $3CD do appb(rgs.stdregs[x]);
  589.   appw(8);
  590.   appw(crtc+4);
  591.   for x:=$3D8 to $3DF do appb(rgs.stdregs[x]);
  592.   appw(0);
  593.   FormatRgs:=bts;
  594. end;
  595.  
  596.  
  597. procedure dumpVGAregfile;
  598. var
  599.   f:file of regtype;
  600. begin
  601.   assign(f,'register.vga');
  602.   {$i-}
  603.   reset(f);
  604.   {$i+}
  605.   if ioresult=0 then seek(f,filesize(f)) else rewrite(f);
  606.   write(f,rgs);
  607.   close(f);
  608. end;
  609.  
  610.  
  611.  
  612.  
  613.  
  614.    (*  Tests for various adapters  *)
  615.  
  616.  
  617. procedure _ahead;
  618. var old:word;
  619. begin
  620.   old:=rdinx(GRC,$F);
  621.   wrinx(GRC,$F,0);
  622.   if not testinx2(GRC,$C,$FB) then
  623.   begin
  624.     wrinx(GRC,$F,$20);
  625.     if testinx2(GRC,$C,$FB) then
  626.     begin
  627.       case rdinx(GRC,$F) and 15 of
  628.     0:begin
  629.         Version:=AH_A;
  630.         chip:=__aheadA;
  631.       end;
  632.     1:begin
  633.         Version:=AH_B;
  634.         chip:=__aheadB;
  635.         features:=ft_rwbank;
  636.       end;
  637.       end;
  638.       case rdinx(GRC,$1F) and 3 of
  639.     0:mm:=256;
  640.     1:mm:=512;
  641.     2:;
  642.     3:mm:=1024;
  643.       end;
  644.       addvideo;
  645.     end;
  646.   end;
  647.   wrinx(GRC,$F,old);
  648. end;
  649.  
  650. procedure _al2101;
  651. begin
  652.   old:=rdinx(crtc,$1A);
  653.   clrinx(crtc,$1A,$10);
  654.   if not testinx(crtc,$19) then
  655.   begin
  656.     setinx(crtc,$1A,$10);
  657.     if testinx(crtc,$19) and testinx2(crtc,$1A,$3F) then
  658.     begin
  659.       Version:=AL_2101;
  660.       chip:=__al2101;
  661.       features:=ft_rwbank+ft_blit+ft_cursor+ft_line;
  662.       case rdinx(crtc,$1e) and 3 of
  663.     0:mm:=256;
  664.     1:mm:=512;
  665.     2:mm:=1024;
  666.     3:mm:=2048;
  667.       end;
  668.       SetDAC(_dacalg,'ALG1101');
  669.       addvideo;
  670.     end;
  671.   end;
  672.   wrinx(crtc,$1A,old);
  673. end;
  674.  
  675. procedure _ati;
  676. var w:word;
  677. begin
  678.   if getbios($31,9)='761295520' then
  679.   begin
  680.     case memw[biosseg:$40] of
  681.      $3133:begin
  682.          IOadr:=memw[biosseg:$10];
  683.          w:=rdinx(IOadr,$BB);
  684.          case w and 15 of
  685.            0:_crt:='EGA';
  686.            1:_crt:='Analog Monochrome';
  687.            2:_crt:='Monochrome';
  688.            3:_crt:='Analog Color';
  689.            4:_crt:='CGA';
  690.            6:_crt:='';
  691.            7:_crt:='IBM 8514/A';
  692.          else _crt:='Multisync';
  693.          end;
  694.          chip:=__ati2;
  695.          SubVers:=mem[biosseg:$43];
  696.          case SubVers of
  697.           $31:begin
  698.             Version:=ATI_18800;
  699.             chip:=__ati1;
  700.           end;
  701.           $32:Version:=ATI_18800_1;
  702.           $33:Version:=ATI_28800_2;
  703.           $34:Version:=ATI_28800_4;
  704.           $35:Version:=ATI_28800_5;
  705.           $61:begin
  706.             chip:=__atiGUP;
  707.             SubVers:=inpw($FAEE);
  708.             case SubVers and $3FF of
  709.              $2F7:Version:=ATI_GUP_6;
  710.              $177:Version:=ATI_GUP_LX;
  711.              $017:Version:=ATI_GUP_AX;
  712.             0:Version:=ATI_GUP_3;
  713.             end;
  714.             SetDAC(_daccl24,'ATI Bogus DAC');
  715.           end;
  716.          else Version:=ATI_Unknown;
  717.          end;
  718.          if Version>=ATI_18800_1 then features:=ft_rwbank;
  719.          case Version of
  720.        ATI_18800,ATI_18800_1:
  721.                if (rdinx(IOadr,$bb) and 32)<>0 then mm:=512;
  722.        ATI_28800_2:if (rdinx(IOadr,$b0) and 16)<>0 then mm:=512;
  723.        ATI_28800_4,ATI_28800_5:
  724.                case rdinx(IOadr,$b0) and $18 of
  725.                0:mm:=256;
  726.              $10:mm:=512;
  727.                8,$18:mm:=1024;
  728.                end;
  729.        ATI_GUP_3..ATI_GUP_LX:
  730.                case inp($36EE) and $C of
  731.              0:mm:=512;
  732.              4:mm:=1024;
  733.              8:mm:=2048;
  734.             12:mm:=4096;
  735.                end;
  736.          end;
  737.        end;
  738.      $3233:begin
  739.          Version:=ATI_EGA;
  740.          video:='EGA';
  741.          chip:=__ega;
  742.        end;
  743.     end;
  744.     addvideo;
  745.   end;
  746. end;
  747.  
  748. procedure _chipstech;
  749. var prt,old,x:word;
  750. begin
  751.   prt:=$46E8;    {Should be $94 for MCA systems}
  752.   old:=inp(prt);     {This can cause problems for non-CT chips,
  753.               as their 46E8h port may be updated incorrectly}
  754.   outp(prt,$E);
  755.   if inp($104)<>$A5 then
  756.   begin
  757.     outp(prt,$1E);
  758.  
  759.     if inp($104)=$A5 then
  760.     begin
  761.       x:=inp($103);
  762.       outp($103,x or $80);  {Enable extensions}
  763.       outp(prt,$E);
  764.       if (x and $40)=0 then IOadr:=$3D6 else IOadr:=$3B6;
  765.       SubVers:=rdinx(IOadr,0);
  766.       case SubVers shr 4 of
  767.     0:Version:=CT_451;
  768.     1:Version:=CT_452;
  769.     2:Version:=CT_455;
  770.     3:Version:=CT_453;
  771.     4:Version:=CT_450;
  772.     5:Version:=CT_456;
  773.     6:Version:=CT_457;
  774.     7:Version:=CT_65520;
  775.     8:Version:=CT_65530;
  776.         9:Version:=CT_65510;
  777.       else Version:=CT_Unknown;
  778.       end;
  779.       case Version of
  780.     CT_452:begin
  781.          CHIP:=__chips452;
  782.          features:=ft_cursor;
  783.            end;
  784.     CT_450,
  785.     CT_453:CHIP:=__chips453;
  786.       else chip:=__chips451;
  787.       end;
  788.       case rdinx(IOadr,4) and 3 of
  789.     1:mm:=512;
  790.       2,3:mm:=1024;
  791.       end;
  792.       addvideo;
  793.     end;
  794.   end;
  795. end;
  796.  
  797. procedure _cirrus;
  798. var old,old6:word;
  799. begin
  800.   old6:=rdinx(SEQ,6);
  801.   old:=rdinx(crtc,$C);
  802.   outp(crtc+1,0);
  803.   SubVers:=rdinx(crtc,$1F);
  804.   wrinx(SEQ,6,lo(Subvers shr 4) or lo(Subvers shl 4));
  805.                          {The SubVers value is rotated by 4}
  806.   if inp(SEQ+1)=0 then
  807.   begin
  808.     outp($3c5,SubVers);
  809.     if inp($3c5)=1 then
  810.     begin
  811.       case SubVers of
  812.     $EC:Version:=CL_GD5x0;
  813.     $CA:Version:=CL_GD6x0;
  814.     $EA:Version:=CL_V7_OEM;
  815.       else Version:=CL_old_unk;
  816.       end;
  817.       chip:=__cirrus;
  818.       addvideo;
  819.     end;
  820.   end;
  821.   wrinx(crtc,$C,old);
  822.   wrinx(SEQ,6,old6);
  823. end;
  824.  
  825.  
  826. procedure _cirrus54;
  827. var x,old:word;
  828. begin
  829.   old:=rdinx(SEQ,6);
  830.   wrinx(SEQ,6,0);
  831.   if (rdinx(SEQ,6)=$F) then
  832.   begin
  833.     wrinx(SEQ,6,$12);
  834.     if (rdinx(SEQ,6)=$12) and testinx2(SEQ,$1E,$3F) {and testinx2(crtc,$1B,$ff)} then
  835.     begin
  836.       case rdinx(SEQ,$A) and $18 of    {memory}
  837.     0:mm:=256;
  838.     8:mm:=512;
  839.        16:mm:=1024;
  840.        24:mm:=2048;
  841.       end;
  842.       SubVers:=rdinx(crtc,$27);
  843.       if testinx(GRC,9) then
  844.       begin
  845.     case SubVers of
  846.             $18:Version:=CL_AVGA2;
  847.             $88:Version:=CL_GD5402;
  848.             $89:Version:=CL_GD5402r1;
  849.             $8A:Version:=CL_GD5420;
  850.             $8B:Version:=CL_GD5420r1;
  851.        $8C..$8F:Version:=CL_GD5422;
  852.        $90..$93:Version:=CL_GD5426;
  853.        $94..$97:Version:=CL_GD5424;
  854.        $98..$9B:Version:=CL_GD5428;
  855.        $A4..$A7:Version:=CL_GD543x;
  856.     else Version:=CL_Unk54;
  857.     end;
  858.     SetDAC(_dacCL24,'Cirrus CL24');
  859.       end
  860.       else if testinx(SEQ,$19) then
  861.     case SubVers shr 6 of
  862.       0:Version:=CL_GD6205;
  863.       1:Version:=CL_GD6235;
  864.       2:Version:=CL_GD6215;
  865.       3:Version:=CL_GD6225;
  866.     end
  867.       else begin
  868.     Version:=CL_AVGA2;
  869.     case rdinx(SEQ,$A) and 3 of
  870.       0:mm:=256;
  871.       1:mm:=512;
  872.       2:mm:=1024;
  873.     end;
  874.       end;
  875.       features:=ft_cursor;
  876.       chip:=__cir54;
  877.       addvideo;
  878.     end;
  879.   end
  880.   else wrinx(SEQ,6,old);
  881. end;
  882.  
  883. procedure _cirrus64;
  884. var x,old:word;
  885. begin
  886.   old:=rdinx(GRC,$A);
  887.   wrinx(GRC,$A,$CE);  {Lock}
  888.   if (rdinx(GRC,$A)=0) then
  889.   begin
  890.     wrinx(GRC,$A,$EC);  {unlock}
  891.     if (rdinx(GRC,$A)=1) then
  892.     begin
  893.       SubVers:=rdinx(GRC,$AA);
  894.       case SubVers shr 4 of
  895.     4:Version:=CL_GD6440;
  896.     5:Version:=CL_GD6412;
  897.     6:Version:=CL_GD5410;
  898.     7:Version:=CL_GD6420;
  899.     8:Version:=CL_GD6410;
  900.       else Version:=CL_Unk64;
  901.       end;
  902.       case rdinx(GRC,$BB) shr 6 of
  903.     0:mm:=256;
  904.     1:mm:=512;
  905.     2:mm:=768;
  906.     3:mm:=1024;
  907.       end;
  908.       chip:=__cir64;
  909.       addvideo;
  910.     end;
  911.   end;
  912.   wrinx(GRC,$A,old);
  913. end;
  914.  
  915.  
  916. procedure _compaq;
  917. var old,x:word;
  918. begin
  919.   old:=rdinx(GRC,$F);
  920.   wrinx(GRC,$F,0);
  921.   if not testinx(GRC,$45) then
  922.   begin
  923.     wrinx(GRC,$F,5);
  924.     if testinx(GRC,$45) then
  925.     begin
  926.       chip:=__compaq;
  927.       features:=ft_blit;
  928.       SubVers:=rdinx(GRC,$C) shr 3;
  929.       case SubVers of
  930.     3:Version:=CPQ_IVGS;
  931.     5:Version:=CPQ_AVGA;
  932.     6:Version:=CPQ_QV1024;
  933.        $E:if (rdinx(GRC,$56) and 4)<>0 then Version:=CPQ_QV1280
  934.                                        else Version:=CPQ_QV1024;
  935.       $10:Version:=CPQ_AVPort;
  936.       else Version:=CPQ_Unknown;
  937.       end;
  938.       if (rdinx(GRC,$C) and $B8)=$30 then  {QVision}
  939.       begin
  940.     features:=features + ft_cursor;
  941.     wrinx(GRC,$F,$F);
  942.     case rdinx(GRC,$54) of
  943.       0:mm:=1024;  {QV1024 fix}
  944.       2:mm:=512;
  945.       4:mm:=1024;
  946.       8:mm:=2048;
  947.     end;
  948.         DAC_RS2:=$8000;
  949.         DAC_RS3:=$1000;
  950.       end
  951.       else begin
  952.     rp.bx:=0;
  953.     rp.cx:=0;
  954.     vio($BF03);
  955.     if (rp.ch and 64)=0 then mm:=512;
  956.       end;
  957.       addvideo;
  958.     end
  959.   end;
  960.   wrinx(GRC,$F,old);
  961. end;
  962.  
  963. procedure _everex;
  964. var x:word;
  965. begin
  966.   rp.bx:=0;
  967.   vio($7000);
  968.   if rp.al=$70 then
  969.   begin
  970.     x:=rp.dx shr 4;
  971.     if  (x<>$678) and (x<>$236)
  972.     and (x<>$620) and (x<>$673) then     {Some Everex boards use Trident chips.}
  973.     begin
  974.       case rp.ch shr 6 of
  975.     0:mm:=256;
  976.     1:mm:=512;
  977.     2:mm:=1024;
  978.     3:mm:=2048;
  979.       end;
  980.       name:='Everex Ev'+hx[x shr 8]+hx[(x shr 4) and 15]+hx[x and 15];
  981.       chip:=__everex;
  982.       addvideo;
  983.     end;
  984.   end;
  985. end;
  986.  
  987. procedure _genoa;
  988. var ad:word;
  989. begin
  990.   ad:=memw[biosseg:$37];
  991.   if (memw[biosseg:ad+2]=$6699) and (mem[biosseg:ad]=$77) then
  992.   begin
  993.     case mem[biosseg:ad+1] of
  994.       0:Version:=GE_6200;
  995.     $11:begin
  996.       Version:=GE_6400;
  997.       mm:=512;
  998.     end;
  999.     $22:Version:=GE_6100;
  1000.     $33:Version:=GE_5100;  {Do we need to detect the Tseng versions ??}
  1001.     $55:begin
  1002.       Version:=GE_5300;
  1003.       mm:=512;
  1004.     end;
  1005.     end;
  1006.     if mem[biosseg:ad+1]<$33 then chip:=__genoa else chip:=__ET3000;
  1007.     addvideo;
  1008.   end
  1009. end;
  1010.  
  1011. procedure _hmc;
  1012. begin
  1013.   if testinx(SEQ,$E7) and testinx(SEQ,$EE) then
  1014.   begin
  1015.     if (rdinx(SEQ,$E7) and $10)>0 then mm:=512;
  1016.     chip:=__HMC;
  1017.     Version:=HMC_304;
  1018.     addvideo;
  1019.   end;
  1020. end;
  1021.  
  1022. procedure _mxic;
  1023. begin
  1024.   old:=rdinx(SEQ,$A7);
  1025.   wrinx(SEQ,$A7,0);       {disable extensions}
  1026.   if not testinx(SEQ,$C5) then
  1027.   begin
  1028.     wrinx(SEQ,$A7,$87);   {enable extensions}
  1029.     if testinx(SEQ,$C5) then
  1030.     begin
  1031.       chip:=__mxic;
  1032.       if (rdinx(SEQ,$26) and 1)=0 then Version:=MX_86010
  1033.       else Version:=MX_86000;   {Does this work, else test 85h bit 1 ??}
  1034.       case (rdinx(SEQ,$C2)  shr 2) and 3 of
  1035.     0:mm:=256;
  1036.     1:mm:=512;
  1037.     2:mm:=1024;
  1038.       end;
  1039.       addvideo;
  1040.     end;
  1041.   end;
  1042.   wrinx(SEQ,$A7,old);
  1043. end;
  1044.  
  1045. procedure _ncr;
  1046. var x:word;
  1047. begin
  1048.   if testinx2(SEQ,5,5) then
  1049.   begin
  1050.     wrinx(SEQ,5,0);        {Disable extended registers}
  1051.     if not testinx(SEQ,$10) then
  1052.     begin
  1053.       wrinx(SEQ,5,1);        {Enable extended registers}
  1054.       if testinx(SEQ,$10) then
  1055.       begin
  1056.     chip:=__ncr;
  1057.     SubVers:=rdinx(SEQ,8);
  1058.     case SubVers shr 4 of
  1059.       0:Version:=NCR_77C22;
  1060.       1:Version:=NCR_77C21;
  1061.       2:Version:=NCR_77C22E;
  1062.       8..15:Version:=NCR_77C22Ep;
  1063.     else Version:=NCR_Unknown;
  1064.     end;
  1065.     features:=ft_rwbank+ft_cursor;
  1066.     name:=name+' Rev. '+istr(rdinx(SEQ,8) and 15);
  1067.     if setmode($13) then;
  1068.     checkmem(64);
  1069.     addvideo;
  1070.       end;
  1071.     end;
  1072.   end;
  1073. end;
  1074.  
  1075. procedure _oak;
  1076. var i:word;
  1077. begin
  1078.   if testinx2($3DE,$D,$38) then
  1079.   begin
  1080.     features:=ft_rwbank;
  1081.     if testinx2($3DE,$23,$1F) then
  1082.     begin
  1083.       case rdinx($3DE,2) and 6 of
  1084.     0:mm:=256;
  1085.     2:mm:=512;
  1086.     4:mm:=1024;
  1087.     6:mm:=2048;
  1088.       end;
  1089.       chip:=__oak87;
  1090.       if (rdinx($3DE,0) and 2)=0 then Version:=OAK_087
  1091.                  else version:=OAK_083;
  1092.     end
  1093.     else begin
  1094.       SubVers:=inp($3DE) shr 5;
  1095.       case SubVers of
  1096.     0:Version:=OAK_037;
  1097.     2:Version:=OAK_067;
  1098.     5:Version:=OAK_077;
  1099.     7:Version:=OAK_057;
  1100.       else Version:=OAK_Unknown;
  1101.       end;
  1102.  
  1103.       case rdinx($3de,13) shr 6 of
  1104.     2:mm:=512;
  1105.       1,3:mm:=1024;    {1 might not give 1M??}
  1106.       end;
  1107.       chip:=__oak;
  1108.     end;
  1109.     features:=ft_rwbank;
  1110.     addvideo;
  1111.   end;
  1112. end;
  1113.  
  1114. procedure _p2000;
  1115. begin
  1116.   if testinx2(GRC,$3D,$3F) and tstrg($3D6,$1F) and tstrg($3D7,$1F) then
  1117.   begin
  1118.     Version:=PR_2000;
  1119.     chip:=__p2000;
  1120.     features:=ft_rwbank+ft_blit;
  1121.     if setmode($13) then;
  1122.     checkmem(32);
  1123.     addvideo;
  1124.   end;
  1125. end;
  1126.  
  1127. procedure _paradise;
  1128. var old,old2:word;
  1129. begin
  1130.   old:=rdinx(GRC,$F);
  1131.   setinx(GRC,$F,$17);   {Lock registers}
  1132.  
  1133.   if not testinx2(GRC,9,$7F) then
  1134.   begin
  1135.     wrinx(GRC,$F,5);      {Unlock them again}
  1136.     if testinx2(GRC,9,$7F) then
  1137.     begin
  1138.       old2:=rdinx(crtc,$29);
  1139.       modinx(crtc,$29,$8F,$85);   {Unlock WD90Cxx registers}
  1140.       if not testinx(crtc,$2B) then Version:=WD_PVGA1A
  1141.       else begin
  1142.     wrinx(SEQ,6,$48);   {Enable C1x extensions}
  1143.     if not testinx2(SEQ,7,$F0) then Version:=WD_90C00
  1144.     else if not testinx(SEQ,$10) then
  1145.     begin
  1146.           if testinx2(crtc,$31,$68) then Version:=WD_90c22
  1147.           else if testinx2(crtc,$31,$90) then Version:=WD_90c20A
  1148.           else Version:=WD_90C20;
  1149.       wrinx(crtc,$34,$A6);
  1150.       if (rdinx(crtc,$32) and $20)<>0 then wrinx(crtc,$34,0);
  1151.     end
  1152.     else begin
  1153.       features:=ft_rwbank;
  1154.       if testinx2(SEQ,$14,$F) then
  1155.       begin
  1156.         SubVers:=(rdinx(crtc,$36) shl 8)+rdinx(crtc,$37);
  1157.         case SubVers of
  1158.           $3234:Version:=WD_90c24;
  1159.           $3236:Version:=WD_90C26;
  1160.           $3330:Version:=WD_90c30;
  1161.           $3331:begin
  1162.                       Version:=WD_90C31;
  1163.                       features:=features+ft_cursor+ft_blit;
  1164.                     end;
  1165.           $3333:begin
  1166.                       Version:=WD_90C33;
  1167.                       features:=features+ft_cursor;
  1168.                     end;
  1169.         end;
  1170.       end
  1171.       else if not testinx2(SEQ,$10,4) then Version:=WD_90C10
  1172.                       else Version:=WD_90C11;
  1173.     end;
  1174.       end;
  1175.       case rdinx(GRC,11) shr 6 of
  1176.          2:mm:=512;
  1177.          3:mm:=1024;
  1178.       end;
  1179.       if (Version>=WD_90c33) and ((rdinx(crtc,$3E) and $80)>0) then mm:=2048;
  1180.       wrinx(crtc,$29,old2);
  1181.       chip:=__paradise;
  1182.       addvideo;
  1183.     end;
  1184.   end;
  1185.   wrinx(GRC,$F,old);
  1186. end;
  1187.  
  1188. procedure _realtek;
  1189. var x:word;
  1190. begin
  1191.   if testinx2(crtc,$1F,$3F) and tstrg($3D6,$F) and tstrg($3D7,$F) then
  1192.   begin
  1193.     chip:=__realtek;
  1194.     SubVers:=rdinx(crtc,$1A) shr 6;
  1195.     case SubVers of
  1196.       0:Version:=RT_3103;
  1197.       1:Version:=RT_3105;
  1198.       2:Version:=RT_3106;
  1199.     else Version:=RT_unknown;
  1200.     end;
  1201.     case rdinx(crtc,$1e) and 15 of
  1202.       0:mm:=256;
  1203.       1:mm:=512;
  1204.       2:if x=0 then mm:=768  else mm:=1024;
  1205.       3:if x=0 then mm:=1024 else mm:=2048;
  1206.     end;
  1207.     features:=ft_rwbank;
  1208.     addvideo;
  1209.   end;
  1210. end;
  1211.  
  1212. procedure _s3;
  1213. begin
  1214.   wrinx(crtc,$38,0);
  1215.   if not testinx2(crtc,$35,$F) then
  1216.   begin
  1217.     wrinx(crtc,$38,$48);
  1218.     if testinx2(crtc,$35,$F) then
  1219.     begin
  1220.       features:=ft_blit+ft_line+ft_cursor;
  1221.       SubVers:=rdinx(crtc,$30);
  1222.       case SubVers of
  1223.     $81:Version:=S3_911;
  1224.     $82:Version:=S3_924;
  1225.     $90:Version:=S3_928C;
  1226.     $91:Version:=S3_928D;
  1227.    $94..$95:Version:=S3_928E;
  1228.     $A0:if (rdinx(crtc,$36) and 2)<>0 then Version:=S3_801AB
  1229.                       else Version:=S3_805AB;
  1230.    $A2..$A4:if (rdinx(crtc,$36) and 2)<>0 then Version:=S3_801C
  1231.                       else Version:=S3_805C;
  1232.         $A5:if (rdinx(crtc,$36) and 2)<>0 then Version:=S3_801D
  1233.                       else Version:=S3_805D;
  1234.     $B0:Version:=S3_928PCI;
  1235.       else Version:=S3_Unknown;
  1236.       end;
  1237.       if (SubVers<$90) then    (* 911 and 924 *)
  1238.       begin
  1239.     if (rdinx(crtc,$41) and $10)<>0 then mm:=1024
  1240.                     else mm:=512;
  1241.       end
  1242.       else case rdinx(crtc,$36) and $E0 of
  1243.        0,$80:mm:=2048;
  1244.      $C0,$40:mm:=1024;
  1245.      $E0,$60:mm:=512;
  1246.        end;
  1247.       chip:=__S3;
  1248.       addvideo;
  1249.     end;
  1250.   end;
  1251. end;
  1252.  
  1253. procedure _trident;
  1254. var old,val,Xseg:word;
  1255.   Phadr:longint;
  1256. begin
  1257.   wrinx(SEQ,$B,0);
  1258.   SubVers:=inp(SEQ+1);
  1259.   old:=rdinx(SEQ,$E);
  1260.   outp(SEQ+1,0);
  1261.   val:=inp(SEQ+1);
  1262.   outp(SEQ+1,old);
  1263.   if (val and 15)=2 then
  1264.   begin
  1265.     outp($3c5,old xor 2);   (* Trident should restore bit 1 reversed *)
  1266.     case SubVers of
  1267.       1:Version:=TR_8800BR;   {This'll never happen}
  1268.       2:Version:=TR_8800CS;
  1269.       3:Version:=TR_8900B;
  1270.   4,$13:Version:=TR_8900C;
  1271.     $23:Version:=TR_9000;
  1272.     $33:Version:=TR_8900CL;
  1273.     $43:Version:=TR_9000i;
  1274.     $53:Version:=TR_8900CXr;
  1275.     $63:Version:=TR_LCD9100B;
  1276.     $83:Version:=TR_LX8200;
  1277.     $93:Version:=TR_9200CXi;
  1278.     $A3:Version:=TR_LCD9320;
  1279. $73,$F3:Version:=TR_GUI9420;
  1280.     else Version:=TR_Unknown;
  1281.     end;
  1282.     case SubVers and 15 of
  1283.       1:chip:=__tridbr;
  1284.       2:chip:=__tridCS;
  1285.     3,4:chip:=__trid89;
  1286.     end;
  1287.     if (pos('Zymos Poach 51',getbios(0,255))>0) or
  1288.        (pos('Zymos Poach 51',getbios(230,255))>0) then
  1289.     begin
  1290.       name:=name+' (Zymos Poach)';
  1291.       chip:=__poach;
  1292.     end;
  1293.     if (SubVers=2) and (tstrg($2168,$f)) then
  1294.     begin
  1295.       IOadr:=$2160;
  1296.       chip:=__IITAGX;
  1297.       Version:=IIT_AGX;
  1298.       if setmode($65) then;
  1299.       checkmem(32);
  1300.       XGAseg:=$B1F0;
  1301.       Phadr:=$FF800000;
  1302.  
  1303.     end
  1304.     else begin
  1305.       if (SubVers>=3) then
  1306.       begin
  1307.     case rdinx(crtc,$1f) and 3 of
  1308.       0:mm:=256;
  1309.       1:mm:=512;
  1310.       2:mm:=768;
  1311.       3:mm:=1024;
  1312.     end;
  1313.       end
  1314.       else
  1315.       if (rdinx(crtc,$1F) and 2)>0 then mm:=512;
  1316.     end;
  1317.     addvideo;
  1318.   end
  1319.   else begin  {Trident 8800BR tests}
  1320.     if (subvers=1) and testinx2(SEQ,$E,6) then
  1321.     begin
  1322.       Version:=TR_8800BR;
  1323.       chip:=__tridBR;
  1324.       if (rdinx(crtc,$1F) and 2)>0 then mm:=512;
  1325.       addvideo;
  1326.     end;
  1327.   end;
  1328. end;
  1329.  
  1330. procedure _tseng;
  1331. var x,vs:word;
  1332. begin
  1333.   outp($3bf,3);
  1334.   outp(crtc+4,$A0);    {Enable Tseng 4000 extensions}
  1335.   if tstrg($3CD,$3F) then
  1336.   begin
  1337.     features:=ft_rwbank;
  1338.     if testinx2(crtc,$33,$F) then
  1339.     begin
  1340.       if tstrg($3CB,$33) then
  1341.       begin
  1342.         features:=features+ft_cursor;
  1343.     chip:=__ET4w32;
  1344.     SubVers:=rdinx($217A,$EC);
  1345.     case SubVers shr 4 of
  1346.       0:Version:=ET_4W32;
  1347.       3:Version:=ET_4W32i;
  1348.       2:Version:=ET_4W32p;
  1349.     else Unk(ET_4Unk,SubVers);
  1350.     end;
  1351.     case rdinx(crtc,$37) and $9 of
  1352.            0:mm:=2048;
  1353.        1:mm:=4096;
  1354.      {  9:mm:=256;}
  1355.        8:mm:=512;
  1356.        9:mm:=1024;
  1357.     end;
  1358.         if (Version<>ET_4W32) and ((rdinx(crtc,$32) and $80)>0) then
  1359.           mm:=mm*2;
  1360.     end
  1361.       else begin
  1362.     chip:=__ET4000;
  1363.     Version:=ET_4000;
  1364.     case rdinx(crtc,$37) and $B of
  1365.      3,9:mm:=256;
  1366.       10:mm:=512;
  1367.       11:mm:=1024;
  1368.     end;
  1369.       end;
  1370.     end
  1371.     else begin
  1372.       Version:=ET_3000;
  1373.       chip:=__ET3000;
  1374.       if setmode($13) then;
  1375.       x:=inp(CRTC+6);
  1376.       x:=rdinx($3c0,$36);
  1377.       outp($3C0,x or $10);
  1378.       case (rdinx(GRC,6) shr 2) and 3 of
  1379.        0,1:vs:=$a000;
  1380.      2:vs:=$b000;
  1381.      3:vs:=$b800;
  1382.       end;
  1383.  
  1384.       meml[vs:1]:=$12345678;
  1385.       if memw[vs:2]=$3456 then mm:=512;
  1386.  
  1387.       wrinx($3c0,$36,x);     {reset value and reenable DAC}
  1388.     end;
  1389.     addvideo;
  1390.   end;
  1391. end;
  1392.  
  1393. procedure _UMC;
  1394. begin
  1395.   old:=inp($3BF);
  1396.   outp($3BF,3);
  1397.   if not testinx(SEQ,6) then
  1398.   begin
  1399.     outp($3BF,$AC);
  1400.     if testinx(SEQ,6) then
  1401.     begin
  1402.       version:=UMC_408;
  1403.       chip:=__UMC;
  1404.       case rdinx(SEQ,7) shr 6 of
  1405.     1:mm:=512;
  1406.       2,3:mm:=1024;
  1407.       end;
  1408.       features:=ft_rwbank;
  1409.       addvideo;
  1410.     end;
  1411.   end;
  1412.   outp($3BF,old);
  1413. end;
  1414.  
  1415.  
  1416. procedure _video7;
  1417. var ram:string[10];
  1418. begin
  1419.   vio($6f00);
  1420.   if rp.bx=$5637 then
  1421.   begin
  1422.     vio($6f07);
  1423.     if rp.ah<128 then ram:='VRAM' else ram:='FASTWRITE';
  1424.  
  1425.  (* old:=rdinx(crtc,$C);
  1426.   wrinx(crtc,$C,old);
  1427.   wrinx($3C4,6,$EA);    {Enable Extensions}
  1428.   if rdinx(crtc,$1F)=(old XOR $EA) then
  1429.   begin
  1430.     wrinx(crtc,$C,old XOR $FF);
  1431.     if rdinx(crtc,$1F)=(old XOR $15) then
  1432.     begin
  1433.       SubVers:=(rdinx($3C4,$8F) shl 8)+rdinx($3C4,$8E);
  1434.     end;
  1435.   end;
  1436.  
  1437.   wrinx(crtc,$C,old);  *)
  1438.  
  1439.  
  1440.     Subvers:=(rdinx(SEQ,$8F) shl 8)+rdinx(SEQ,$8E);
  1441.     case Subvers of
  1442.   $8000..$FFFF:Version:=V7_VEGA;
  1443.   $7000..$70FF:Version:=V7_208_13;
  1444.   $7140..$714F:Version:=V7_208A;
  1445.      $7151:Version:=V7_208B;
  1446.      $7152:Version:=V7_208CD;
  1447.      $7760:Version:=V7_216BC;
  1448.      $7763:Version:=V7_216D;
  1449.      $7764:Version:=V7_216E;
  1450.      $7765:Version:=V7_216F;
  1451.     else Version:=V7_Unknown;
  1452.     end;
  1453.     case rp.ah and 127 of
  1454.       2:mm:=512;
  1455.       4:mm:=1024;
  1456.     end;
  1457.     chip:=__video7;
  1458.     features:=ft_cursor;
  1459.     if Version>=V7_208A then Features:=features+ft_rwbank;
  1460.     addvideo;
  1461.   end
  1462. end;
  1463.  
  1464. procedure _Weitek;
  1465. var x:word;
  1466. begin
  1467.   old:=rdinx(SEQ,$11);
  1468.   outp(SEQ+1,old);
  1469.   outp(SEQ+1,old);
  1470.   outp(SEQ+1,inp(SEQ+1) or $20);
  1471.   if not testinx(SEQ,$12) then
  1472.   begin
  1473.     x:=rdinx(SEQ,$11);
  1474.     outp(SEQ+1,old);
  1475.     outp(SEQ+1,old);
  1476.     outp(SEQ+1,inp(SEQ+1) and $DF);
  1477.     if testinx(SEQ,$12) and tstrg($3CD,$FF) then
  1478.     begin
  1479.       chip:=__Weitek;
  1480.       Version:=WT_5186;  {Should check for version and memory}
  1481.       mm:=256;
  1482.       addvideo;
  1483.     end;
  1484.   end;
  1485.   wrinx(SEQ,$11,old);
  1486. end;
  1487.  
  1488. procedure _XGA;
  1489. var p:pointer;
  1490.  posbase,cardid,xga_base,x,cx:word;
  1491.  temp0,temp1,temp2,temp3:byte;
  1492. begin
  1493.   getintvec($15,p);
  1494.   if (seg(p^)<>0) then
  1495.   begin
  1496.     rp.ax:=$C400;
  1497.     rp.dx:=$ffff;
  1498.     intr($15,rp);
  1499.     if not odd(rp.flags) and (rp.dx<>$ffff) then
  1500.     begin
  1501.       posbase:=rp.dx;
  1502.       for cx:=0 to 9 do
  1503.       begin
  1504.     disable;   (* CLI -  Disable interrupts *)
  1505.     if cx=0 then outp($94,$DF)
  1506.     else begin
  1507.       rp.ax:=$C401;
  1508.       rp.bx:=cx;
  1509.       intr($15,rp);
  1510.     end;
  1511.     cardid:=inpw(posbase);
  1512.     temp0:=inp(posbase+2);
  1513.     temp1:=inp(posbase+3);
  1514.     temp2:=inp(posbase+4);
  1515.     temp3:=inp(posbase+5);
  1516.     if cx=0 then outp($94,$FF)
  1517.     else begin
  1518.       rp.ax:=$C402;
  1519.       rp.bx:=cx;
  1520.       intr($15,rp);
  1521.     end;
  1522.     enable;   (* STI -  Enable interrupts *)
  1523.     if (cardid>=$8FD8) and (cardid<=$8FDB) then
  1524.     begin
  1525.       IOadr:=$2100+(temp0 and $E)*8;
  1526.       x:=rdinx(IOadr+10,$52) and 15;
  1527.       if (x<>0) and (x<>15) then
  1528.       begin
  1529.         chip:=__XGA;
  1530.         outp(IOadr+4,0);
  1531.         outp(IOadr,4);
  1532.         checkmem(16);
  1533.         case cardid of
  1534.          $8FDA:Version:=XGA_NI;
  1535.          $8FDB:Version:=XGA_org;
  1536.         end;
  1537.  
  1538.         XGAseg:=(temp0 shr 4)*$2000+$C1C0+(temp0 and $E)*4;
  1539.         Phadr:=((temp2 and $FE)*word(8)+(temp0 and $E))*longint($200000);
  1540.         addvideo;
  1541.       end;
  1542.     end;
  1543.       end;
  1544.     end;
  1545.   end;
  1546. end;
  1547.  
  1548. procedure _yamaha;
  1549. begin
  1550.   if testinx2(crtc,$7C,$7C) then
  1551.   begin
  1552.     Version:=YA_6388;
  1553.     addvideo;
  1554.   end;
  1555. end;
  1556.  
  1557. procedure _xbe;
  1558. var
  1559.   x:word;
  1560.   xbe0:_xbe0;
  1561.   xbe1:_xbe1;
  1562.  
  1563. begin
  1564.   viop($4E00,0,0,0,@xbe0);
  1565.   if (rp.ax=$4E) and (xbe0.sign=$41534556) then
  1566.   begin
  1567.     for x:=0 to xbe0.xgas-1 do
  1568.     begin
  1569.       viop($4E01,0,0,x,@xbe1);
  1570.       if (rp.ax=$4E) then
  1571.       begin
  1572.     chip:=__xbe;
  1573.     mm:=xbe1.memory*longint(64);
  1574.     Instance:=x;
  1575.     IOadr :=xbe1.iobase;
  1576.     XGAseg:=xbe1.memreg;
  1577.     Phadr :=xbe1.vidadr;
  1578.     name:=gtstr(xbe1.oemadr);
  1579.     UNK(VS_XBE,xbe0.vers);
  1580.     addvideo;
  1581.       end;
  1582.     end;
  1583.   end;
  1584. end;
  1585.  
  1586. procedure _vesa;
  1587. var
  1588.   vesarec:_vbe0;
  1589.   x:word;
  1590. begin
  1591.   viop($4f00,0,0,0,@vesarec);
  1592.   if (rp.ax=$4f) and (vesarec.sign=$41534556) then
  1593.   begin
  1594.     chip:=__vesa;
  1595.     mm:=vesarec.mem*longint(64);
  1596.     name:=gtstr(vesarec.oemadr);
  1597.     UNK(VS_VBE,vesarec.vers);
  1598.     dactype:=_dac8;    {Dummy, to keep Cirrus 542x out of trouble}
  1599.     addvideo;
  1600.   end;
  1601. end;
  1602.  
  1603.  
  1604. type
  1605.   pel=record
  1606.     index,red,green,blue:byte;
  1607.       end;
  1608.  
  1609. procedure readpelreg(index:word;var p:pel);
  1610. begin
  1611.   p.index:=index;
  1612.   disable;
  1613.   outp($3C7,index);
  1614.   p.red  :=inp($3C9);
  1615.   p.blue :=inp($3C9);
  1616.   p.green:=inp($3C9);
  1617.   enable;
  1618. end;
  1619.  
  1620. procedure writepelreg(var p:pel);
  1621. begin
  1622.   disable;
  1623.   outp($3C8,p.index);
  1624.   outp($3C9,p.red);
  1625.   outp($3C9,p.blue);
  1626.   outp($3C9,p.green);
  1627.   enable;
  1628. end;
  1629.  
  1630. function setcomm(cmd:word):word;
  1631. begin
  1632.   dac2comm;
  1633.   outp($3c6,cmd);
  1634.   dac2comm;
  1635.   setcomm:=inp($3c6);
  1636. end;
  1637.  
  1638.  
  1639. procedure testdac;      {Test for type of DAC}
  1640. var
  1641.   x,y,z,v,oldcomm,oldpel,notcomm:word;
  1642.   dac8,dac8now:boolean;
  1643.  
  1644.  
  1645. procedure waitforretrace;
  1646. begin
  1647.   repeat until (inp(CRTC+6) and 8)=0;
  1648.   repeat until (inp(CRTC+6) and 8)>0;    {Wait until we're in retrace}
  1649. end;
  1650.  
  1651. function dacis8bit:boolean;
  1652. var
  1653.   pel2,x,v:word;
  1654.   pel1:pel;
  1655. begin
  1656.   pel2:=inp($3C8);
  1657.   readpelreg(255,pel1);
  1658.   v:=pel1.red;
  1659.   pel1.red:=255;
  1660.   writepelreg(pel1);
  1661.   readpelreg(255,pel1);
  1662.   x:=pel1.red;
  1663.   pel1.red:=v;
  1664.   writepelreg(pel1);
  1665.   outp($3C8,pel2);
  1666.   dacis8bit:=(x=255);
  1667. end;
  1668.  
  1669. function testdacbit(bit:word):boolean;
  1670. var v:word;
  1671. begin
  1672.   dac2pel;
  1673.   outp($3C6,oldpel and (bit xor $FF));
  1674.   dac2comm;
  1675.   disable;
  1676.   outp($3C6,oldcomm or bit);
  1677.   v:=inp($3C6);
  1678.   outp($3C6,v and (bit xor $FF));
  1679.   enable;
  1680.   testdacbit:=(v and bit)<>0;
  1681. end;
  1682.  
  1683. begin
  1684.   setDAC(_dac8,'Normal');
  1685.   dac2comm;
  1686.   oldcomm:=inp($3c6);
  1687.   dac2pel;
  1688.   oldpel:=inp($3c6);
  1689.  
  1690.   dac2comm;
  1691.   outp($3C6,0);
  1692.   dac8:=dacis8bit;
  1693.   dac2pel;
  1694.  
  1695.   notcomm:=oldcomm xor 255;
  1696.   outp($3C6,notcomm);
  1697.   dac2comm;
  1698.   v:=inp($3C6);
  1699.   if v<>notcomm then
  1700.   begin
  1701.     if (setcomm($E0) and $E0)<>$E0 then
  1702.     begin
  1703.       dac2pel;
  1704.       x:=inp($3C6);
  1705.       repeat
  1706.     y:=x;         {wait for the same value twice}
  1707.     x:=inp($3C6);
  1708.       until (x=y);
  1709.       z:=x;
  1710.       dac2comm;
  1711.       if daccomm<>$8E then
  1712.       begin                 {If command register=$8e, we've got an SS24}
  1713.     y:=8;
  1714.     repeat
  1715.       x:=inp($3C6);
  1716.       dec(y);
  1717.     until (x=$8E) or (y=0);
  1718.       end
  1719.       else x:=daccomm;
  1720.       if x=$8e then setDAC(_dacss24,'SS24')
  1721.            else setDAC(_dac15,'Sierra SC11486');
  1722.       dac2pel;
  1723.     end
  1724.     else begin
  1725.       if (setcomm($60) and $E0)=0 then
  1726.       begin
  1727.         if (setcomm(2) and 2)>0 then setDAC(_dacatt,'ATT 20c490')
  1728.                                 else setDAC(_dacatt,'ATT 20c493');
  1729.       end
  1730.       else begin
  1731.     x:=setcomm(oldcomm);
  1732.     if inp($3C6)=notcomm then
  1733.     begin
  1734.       if setcomm($FF)<>$FF then setDAC(_dacadac1,'Acumos ADAC1')
  1735.       else begin
  1736.         dac8now:=dacis8bit;
  1737.         dac2comm;
  1738.         outp($3C6,(oldcomm or 2) and $FE);
  1739.         dac8now:=dacis8bit;
  1740.         if dac8now then
  1741.           if dacis8bit then setDAC(_dacatt,'ATT 20c491')
  1742.                else setDAC(_dacCL24,'Cirrus 24bit DAC')
  1743.         else setDAC(_dacatt,'ATT 20c492');
  1744.       end;
  1745.     end
  1746.     else begin
  1747.       if trigdac=notcomm then setDAC(_dacCL24,'Cirrus 24bit DAC')
  1748.       else begin
  1749.         dac2pel;
  1750.         outp($3C6,$FF);
  1751.         case trigdac of
  1752.               $44:setDAC(_dacmus,'MUSIC ??');  {4870 ??}
  1753.           $82:setDAC(_dacmus,'MUSIC MU9C4910');
  1754.           $8E:setDAC(_dacss24,'Diamond SS2410');
  1755.         else
  1756.               if testdacbit($10) then setDAC(_dacsc24,'Sierra 16m')
  1757.               else if testdacbit(4) then setDAC(_dacUnk9,'Unknown DAC #9')
  1758.                 else setDAC(_dac16,'Sierra 32k/64k');
  1759.         end;
  1760.       end;
  1761.     end;
  1762.       end;
  1763.     end;
  1764.  
  1765.     dac2comm;
  1766.     outp($3c6,oldcomm);
  1767.   end;
  1768.   dac2pel;
  1769.   outp($3c6,oldpel);
  1770.  
  1771.   if (dactype=_dac8) and (DAC_RS2<>0) and (DAC_RS3<>0) then
  1772.   begin
  1773.     oldpel :=inp($3C6);
  1774.     oldcomm:=inp($3C6+DAC_RS2);
  1775.     outp($3C6+DAC_RS2,oldpel xor $FF);
  1776.     if (inp($3C6)=oldpel) and (inp($3C6+DAC_RS2)=(oldpel xor $FF)) then
  1777.       SetDAC(_dacBt484,'Brooktree Bt484');
  1778.  
  1779.     outp($3C6+DAC_RS2,oldcomm);
  1780.     outp($3C6,oldpel);
  1781.   end;
  1782.  
  1783.  
  1784.  
  1785.   if dactype=_dac8 then
  1786.   begin
  1787.     WaitforRetrace;
  1788.     outp($3C8,222);
  1789.     outp($3C9,$43);
  1790.     outp($3C9,$45);
  1791.     outp($3C9,$47);    {Write 'CEGEDSUN' + mode to DAC index 222}
  1792.     outp($3C8,222);
  1793.     outp($3C9,$45);
  1794.     outp($3C9,$44);
  1795.     outp($3C9,$53);
  1796.     outp($3C8,222);
  1797.     outp($3C9,$55);
  1798.     outp($3C9,$4E);
  1799.     outp($3C9,13);     {Should be in CEG mode now}
  1800.     outp($3C6,255);
  1801.     x:=(inp($3c6) shr 4) and 7;
  1802.     if x<7 then
  1803.     begin
  1804.       setDAC(_dacCEG,'Edsun CEG rev. '+chr(x+48));
  1805.       WaitforRetrace;
  1806.       outp($3C8,223);
  1807.       outp($3C9,0);    {Back in normal dac mode}
  1808.     end;
  1809.   end;
  1810. end;
  1811.  
  1812.  
  1813. procedure findbios;     {Finds the most likely BIOS segment}
  1814. var
  1815.   score:array[0..7] of byte;
  1816.   x,y:word;
  1817. begin
  1818.   biosseg:=$c000;
  1819.   for x:=0 to 6 do score[x]:=1;
  1820.   for x:=0 to 7 do
  1821.   begin
  1822.     rp.bh:=x;
  1823.     vio($1130);
  1824.     if (rp.es>=$c000) and ((rp.es and $7ff)=0) then
  1825.       inc(score[(rp.es-$c000) shr 11]);
  1826.   end;
  1827.  
  1828.   for x:=0 to 6 do
  1829.   begin
  1830.     y:=$c000+(x shl 11);
  1831.     if (memw[y:0]<>$aa55) or (mem[y:2]<48) then
  1832.       score[x]:=0;                       {fail if no rom}
  1833.   end;
  1834.   for x:=6 downto 0 do
  1835.     if score[x]>0 then
  1836.       biosseg:=$c000+(x shl 11);
  1837. end;
  1838.  
  1839. type
  1840.   fnctyp=procedure;
  1841.  
  1842. const
  1843.   chps=24;
  1844.   chptype:array[1..chps] of chips=(__paradise,__Video7,__MXIC,__UMC
  1845.         ,__Genoa,__Everex,__Trid89,__ati2,__Aheadb,__NCR,__S3,__AL2101
  1846.         ,__Cir54,__Cir64,__Weitek,__ET4000,__Realtek,__P2000
  1847.         ,__Yamaha,__Oak,__Cirrus,__Compaq,__HMC,__chips451);
  1848.  
  1849. var
  1850.   chp,vid1:word;
  1851.  
  1852. procedure findvideo;
  1853. begin
  1854.   vids:=0;
  1855.   dactype:=_dac0;
  1856.   features:=0;
  1857.   if odd(inp($3CC)) then CRTC:=$3D4 else CRTC:=$3B4;
  1858.   if dotest[__VESA] then _vesa;
  1859.   if dotest[__XBE] then _xbe;
  1860.   if dotest[__XGA] then _XGA;
  1861.  
  1862.   _crt:='';
  1863.   chip:=__none;
  1864.   secondary:='';
  1865.   name:='';
  1866.   DAC_RS2:=0;DAC_RS3:=0;
  1867.   video:='none';
  1868.   rp.bx:=$1010;
  1869.   vio($1200);
  1870.   if rp.bh<=1 then
  1871.   begin
  1872.     video:='EGA';
  1873.     chip:=__ega;
  1874.  
  1875.     mm:=rp.bl;
  1876.     vio($1a00);
  1877.     if rp.al=$1a then
  1878.     begin
  1879.       if (rp.bl<4) and (rp.bh>3) then
  1880.       begin
  1881.     old:=rp.bl;
  1882.     rp.bl:=rp.bh;
  1883.     rp.bh:=old;
  1884.       end;
  1885.       video:='MCGA';
  1886.       case rp.bl of
  1887.     2,4,6,10:_crt:='TTL Color';
  1888.     1,5,7,11:_crt:='Monochrome';
  1889.         8,12:_crt:='Analog Color';
  1890.       end;
  1891.       case rp.bh of
  1892.     1:secondary:='Monochrome';
  1893.     2:secondary:='CGA';
  1894.       end;
  1895.       findbios;
  1896.       if (getbios($31,9)='') and (getbios($40,2)='22') then
  1897.       begin
  1898.     video:='EGA';       {@#%@  lying ATI EGA Wonder !}
  1899.     name:='ATI EGA Wonder';
  1900.     addvideo;
  1901.       end else
  1902.       if (rp.bl<10) or (rp.bl>12) then
  1903.       begin
  1904.  
  1905.     chp:=0;vid1:=vids;
  1906.     while (vids=vid1) and (chp<chps) do
  1907.     begin
  1908.       inc(chp);
  1909.  
  1910.       video:='VGA';
  1911.       chip:=__vga;
  1912.       mm:=256;
  1913.       features:=0;
  1914.       dactype:=_dac0;
  1915.       version:=0;
  1916.       subvers:=0;
  1917.  
  1918.       if debug then
  1919.       begin
  1920.         writeln('Testing: '+header[chptype[chp]]);
  1921.         if readkey='' then;
  1922.       end;
  1923.  
  1924.       if dotest[chptype[chp]] then
  1925.             case chptype[chp] of
  1926.               __Aheadb:_Ahead;
  1927.               __AL2101:_AL2101;
  1928.                 __ati2:_Ati;
  1929.             __chips451:_chipstech;
  1930.                __Cir54:_Cirrus54;
  1931.                __Cir64:_Cirrus64;
  1932.               __Cirrus:_Cirrus;
  1933.               __Compaq:_Compaq;
  1934.               __Everex:_Everex;
  1935.                __Genoa:_Genoa;
  1936.                  __HMC:_HMC;
  1937.                 __MXIC:_MXIC;
  1938.                  __NCR:_NCR;
  1939.                  __Oak:_Oak;
  1940.                __P2000:_P2000;
  1941.             __paradise:_paradise;
  1942.              __Realtek:_Realtek;
  1943.                   __S3:_S3;
  1944.               __Trid89:_Trident;
  1945.               __ET4000:_Tseng;
  1946.                  __UMC:_UMC;
  1947.               __Video7:_Video7;
  1948.               __Weitek:_weitek;
  1949.               __Yamaha:_Yamaha;
  1950.             end;
  1951.     end;
  1952.     if vids=vid1 then addvideo;
  1953.       end;
  1954.     end;
  1955.   end;
  1956. end;
  1957.